home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / sbp3_1e.lzh / CONMAN.PL < prev    next >
Text File  |  1991-10-31  |  9KB  |  300 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7. % get1(C)
  8. %  accepts a line of input and returns only the first character.
  9. %  A good way to obtain a 1-character response from the user
  10. %  in a Prolog with buffered input, such as Quintus or ALS.
  11.  
  12. :- multifile get1/1.
  13.  
  14. get1(C) :-
  15.   get(C),
  16.   repeat,
  17.     get0(N),
  18.     (N=10 ; N=13),
  19.   !.
  20.  
  21.  
  22. /* CONMAN.PL */
  23.  
  24. /*
  25.  * Requires procedures defined in files
  26.  * WRITELN.PL, YES.PL, and FINDALL.PL.
  27.  */
  28.  
  29. :- ( clause(writeln(_),_) ; consult('writeln.pl') ).
  30. :- ( clause(yes(_),_) ; consult('yes.pl') ).
  31. :- ( clause(find_all(_),_) ; consult('findall.pl') ).
  32.  
  33. :- dynamic known/3.
  34.  
  35. /*
  36.  * CONMAN user interface
  37.  *   CONMAN modifies and extends the standard Prolog infer-
  38.  *   ence engine, providing the ability to use confidence
  39.  *   factors in reaching conclusions. As a result, we dis-
  40.  *   tinguish the procedures in CONMAN that handle communi-
  41.  *   cation with the user from the predicates that make up
  42.  *   the CONMAN inference engine.
  43.  */
  44.  
  45. conman :- kb_intro(Statement),
  46.           writeln(Statement),nl,
  47.           kb_threshold(T),
  48.           kb_hypothesis(Hypothesis),
  49.           confidence_in([Hypothesis,yes],CF),
  50.           CF >= T,
  51.           write('Conclusion: '),
  52.           writeln(Hypothesis),
  53.           write('Confidence in hypothesis: '),
  54.           write(CF),
  55.           writeln('%.'),
  56.           explain_conclusion(Hypothesis), fail.
  57.  
  58. conman :- kb_hypothesis(Hypothesis),
  59.           confirm([Hypothesis]),!,
  60.           writeln('No further conclusions.'),
  61.           nl, finish_conman.
  62.  
  63. conman :- writeln('Can draw no conclusions.'),
  64.           nl, finish_conman.
  65.  
  66. finish_conman :-
  67.      abolish(known,3),
  68.      write('Do you want to conduct another consultation?'),
  69.      yes('>'), nl, nl,
  70.      asserta(known(xxx,yyy,zzz)), /* dummy predicate */
  71.      !, conman.
  72.  
  73. finish_conman :- asserta(known(xxx,yyy,zzz)).  /* dummy predicate */
  74.  
  75. ask_confidence(Hypothesis,CF) :-
  76.      kb_can_ask(Hypothesis),
  77.      writeln('Is the following conjecture true? --'),
  78.      write('  '), writeln(Hypothesis),
  79.      writeln(['Possible responses: ',
  80.               '  (y) yes            (n) no',
  81.               '  (l) very likely    (v) very unlikely',
  82.               '  (p) probably       (u) unlikely',
  83.               '  (m) maybe          (d) don''t know.',
  84.               '         (?) why?']),
  85.      write('  Your response --> '),
  86.      get0_only([y,l,p,m,n,v,u,d,?],Reply), nl, nl,
  87.      convert_reply_to_confidence(Reply,CF),
  88.      !, Reply \== d,
  89.      ask_confidence_aux(Reply,Hypothesis,CF).
  90.  
  91. ask_confidence_aux(Char,_,_) :- Char \== ?, !.
  92.  
  93. ask_confidence_aux(_,Hypothesis,CF) :-
  94.      explain_question,
  95.      !, ask_confidence(Hypothesis,CF).
  96.  
  97. get0_only(List,Reply) :-
  98.      get1(Char),   % Some Prologs can use get0 here
  99.      name(Value,[Char]),
  100.      member(Value,List),Reply = Value, !.
  101.  
  102. get0_only(List,Result) :-
  103.      put(7), write(' [Invalid response.  Try again.] '),
  104.      get0_only(List,Result).
  105.  
  106. convert_reply_to_confidence(?,_).
  107. convert_reply_to_confidence(d,_).
  108. convert_reply_to_confidence(n,0).
  109. convert_reply_to_confidence(v,5).
  110. convert_reply_to_confidence(u,25).
  111. convert_reply_to_confidence(m,60).
  112. convert_reply_to_confidence(p,80).
  113. convert_reply_to_confidence(l,90).
  114. convert_reply_to_confidence(y,100).
  115.  
  116. explain_question :-
  117.      current_hypothesis(Hypothesis),
  118.      writeln(
  119. 'I need this information to test the following hypothesis:'),
  120.      writeln(Hypothesis), nl,
  121.      writeln('Do you want further explanation?'),
  122.      explain_question_aux,!.
  123.  
  124. explain_question :-
  125.      writeln('This is a basic hypothesis.'),
  126.      nl, wait.
  127.  
  128. explain_question_aux :- \+ yes('>'), nl, nl, !.
  129.  
  130. explain_question_aux :- nl, nl, fail.
  131.  
  132. explain_conclusion(Hypothesis) :-
  133.      writeln('Do you want an explanation?'),
  134.      yes('>'), nl, nl,
  135.      explain_conclusion_aux(Hypothesis), wait, !.
  136.  
  137. explain_conclusion(_) :- nl, nl.
  138.  
  139. explain_conclusion_aux([]) :- !.
  140.  
  141. explain_conclusion_aux([Hypothesis,_]) :-
  142.      !, explain_conclusion_aux(Hypothesis).
  143.  
  144. explain_conclusion_aux([and,[Hypothesis,_],Rest]) :-
  145.      !, explain_conclusion_aux(Hypothesis),
  146.      explain_conclusion_aux(Rest).
  147.  
  148. explain_conclusion_aux([or,[Hypothesis,_],Rest]) :-
  149.      !, explain_conclusion_aux(Hypothesis),
  150.      explain_conclusion_aux(Rest).
  151.  
  152. explain_conclusion_aux(Hypothesis) :-
  153.      known(Hypothesis,CF,user),
  154.      kb_threshold(T),CF >= T,
  155.      !, write(Hypothesis),writeln(' -'),
  156.      write('From what you told me, I accepted this with '),
  157.      write(CF),writeln('% confidence.'), nl.
  158.  
  159. explain_conclusion_aux(Hypothesis) :-
  160.      known(Hypothesis,CF,user),
  161.      !, DisCF is 100 - CF,
  162.      write(Hypothesis),writeln(' -'),
  163.      write('From what you told me, I rejected this with '),
  164.      write(DisCF),writeln('% confidence.'), nl.
  165.  
  166. explain_conclusion_aux(Hypothesis) :-
  167.      known(Hypothesis,50,no_evidence),
  168.      !, write(Hypothesis),writeln(' -'),
  169.      writeln(
  170.           'Having no evidence, I assumed this was 50-50.'),
  171.       nl.
  172.  
  173. explain_conclusion_aux(Hypothesis) :-
  174.      !, known(Hypothesis,CF1,[CF,Prerequisites,Conditions]),
  175.      writeln(Hypothesis),write('Accepted with '),
  176.      write(CF1),
  177.      writeln('% confidence on the basis of the following'),
  178.      write('Rule: '),writeln(Hypothesis),
  179.      write('  with confidence of '),
  180.      write(CF),
  181.      writeln('% if'),
  182.      list_prerequisites(Prerequisites),
  183.      list_conditions(Conditions), nl,
  184.      explain_conclusion_aux(Conditions).
  185.  
  186. list_prerequisites([]) :- !.
  187.  
  188. list_prerequisites([-,Hypothesis|Rest]) :-
  189.      !, write('  is disconfirmed: '),
  190.      writeln(Hypothesis),
  191.      list_prerequisites(Rest).
  192.  
  193. list_prerequisites([Hypothesis|Rest]) :-
  194.      write('  is confirmed: '),
  195.      writeln(Hypothesis),
  196.      list_prerequisites(Rest).
  197.  
  198. list_conditions([]) :- !.
  199.  
  200. list_conditions([and,Hypothesis,Rest]) :-
  201.      list_conditions(Hypothesis),
  202.      list_conditions(Rest).
  203.  
  204. list_conditions([or,Hypothesis,Rest]) :-
  205.      writeln(' ['),
  206.      list_conditions(Hypothesis),
  207.      writeln('     or'),
  208.      list_conditions(Rest), writeln(' ]').
  209.  
  210. list_conditions([Hypothesis,yes]) :-
  211.      write('    to confirm: '),
  212.      writeln(Hypothesis).
  213.  
  214. list_conditions([Hypothesis,no]) :-
  215.      write('    to disconfirm: '),
  216.      writeln(Hypothesis).
  217.  
  218. wait :- write('Press Return when ready to continue. '),
  219.         get0(_), nl, nl.  % Even ALS can use get0 here
  220.  
  221.  
  222.  
  223. /*
  224.  * CONMAN inference engine
  225.  *   The CONMAN inference engine computes the confidence in
  226.  *   compound goals and decides which of several rules best
  227.  *   support a conclusion. It remembers this information for
  228.  *   later use by itself, the main conman procedure, and the
  229.  *   explanatory facilities.
  230.  */
  231.  
  232. confidence_in([],100) :- !.
  233.  
  234. confidence_in([Hypothesis,yes],CF) :-
  235.      known(Hypothesis,CF,_), !.
  236.  
  237. confidence_in([Hypothesis,yes],CF) :-
  238.      ask_confidence(Hypothesis,CF), !,
  239.      assert(known(Hypothesis,CF,user)).
  240.  
  241. confidence_in([Hypothesis,yes],CF) :-
  242.      asserta(current_hypothesis(Hypothesis)),
  243.      find_all(X,evidence_that(Hypothesis,X),List),
  244.      find_all(C,member([C,_],List),CFList),
  245.      retract(current_hypothesis(_)),
  246.      CFList \== [],
  247.      !, maximum(CFList,CF),
  248.      member([CF,Explanation],List),
  249.      assert(known(Hypothesis,CF,Explanation)).
  250.  
  251. confidence_in([Hypothesis,yes],50) :-
  252.      assert(known(Hypothesis,50,no_evidence)), !.
  253.  
  254. confidence_in([Hypothesis,no],CF) :-
  255.      !, confidence_in([Hypothesis,yes],CF0),
  256.      CF is 100 - CF0.
  257.  
  258. confidence_in([and,Conjunct1,Conjunct2],CF) :-
  259.      !, confidence_in(Conjunct1,CF1),
  260.      confidence_in(Conjunct2,CF2),
  261.      minimum([CF1,CF2],CF).
  262.  
  263. confidence_in([or,Disjunct1,Disjunct2],CF) :-
  264.      !, confidence_in(Disjunct1,CF1),
  265.      confidence_in(Disjunct2,CF2),
  266.      maximum([CF1,CF2],CF).
  267.  
  268. evidence_that(Hypothesis,[CF,[CF1,Prerequisite,Condition]]):-
  269.      c_rule(Hypothesis,CF1,Prerequisite,Condition),
  270.      confirm(Prerequisite),
  271.      confidence_in(Condition,CF2),
  272.      CF is (CF1 * CF2)//100.
  273.  
  274. confirm([]).
  275.  
  276. confirm([-,Hypothesis|Rest]) :-
  277.      !, known(Hypothesis,CF,_),
  278.      kb_threshold(T),
  279.      M is 100 - CF, M >= T,
  280.      confirm(Rest).
  281.  
  282. confirm([Hypothesis|Rest]) :-
  283.      known(Hypothesis,CF,_),
  284.      kb_threshold(T),CF >= T,
  285.      !, confirm(Rest).
  286.  
  287. minimum([M,K],M) :- M < K, ! .
  288. minimum([_,M],M).
  289.  
  290. maximum([],0) :- !.
  291. maximum([M],M) :- !.
  292. maximum([M,K],M) :- M >= K, !.
  293. maximum([M|R],N) :- maximum(R,K), maximum([K,M],N).
  294.  
  295. append([],X,X).
  296. append([X|Y],Z,[X|W]) :- append(Y,Z,W).
  297.  
  298. member(X,[X|_]).
  299. member(X,[_|Z]) :- member(X,Z).
  300.